;;visualization for missing data (c) Pedro Valero (valerop@uv.es)
;;Version 1 April, 2000
;;Version 2 January 6, 2001

(defun visualize-missing-data ()
  (send current-data :visualize-missing-data))

(defun my-intersection (l)
     "Outputs the intersection of the members of the lists in l, a list of lists"
     (let* (
       (l l)
       (b (first l))
            )
       (dotimes (i (length l))
            (setf b (intersection b (select l i)))
             )
      (reverse b)))

(defun missingp (data) 
  (if 
   (which (map-elements #'(lambda (x)
                    (equal x nil))
               (combine data)))
   t
   nil))

(defun dummy (var)
  "Args: (VAR) Changes the nil in a variable for zeros and for ones if not nil"
  (if (equal var nil) 0 1))

(defun data-matrix-missing (data)
  "Args: (DATA) Changes the nil in a variable for zeros and for ones if not nil"
  (map-elements 'dummy data))

 (defun cases-in-missing-patterns2 (data)
  "Args: (DATA) Outputs cases in each of the patterns of missing data obtained with the function patterns-missing"
 (let* (
        (data data)
        (patterns (reverse (patterns-missing data)))
        (number-of-patterns (length patterns))
        (matrix-missing (data-matrix-missing data))
        (n (length (row-list matrix-missing)))
        (cases-with-patterns nil)
        )
   (dotimes (i number-of-patterns)
            (setf cases-with-patterns 
                  (append cases-with-patterns 
                          (list (which 
                                 (mapcar #'equalp 
                                         (row-list matrix-missing) 
                                         (repeat (list (select patterns i))
                                                 n))))
                          ))
            )
   (list cases-with-patterns (mapcar #'length cases-with-patterns) patterns matrix-missing)))


(defun patterns-missing (data)
  "Args: (DATA) Outputs the different patterns of missing data in DATA."
  (remove-duplicates 
   (row-list (data-matrix-missing data)) :test 'equalp)
  )


(defun Observed-in-missing-pattern (patterns i)
  "Args: (PATTERNS) PATTERNS are patterns in missing data. I is the pattern to be explored to find which values are present i.e. non-missing. Returns the index of present values."
  (let 
    (
     (patterns patterns)
     (i i)
     (O nil)
     )
    (setf O (which (map-elements #'equalp 1 (select patterns i)))) 
    O))

(defmeth mv-data-object-proto :visualize-missing-data ()
  (cond
     ((not (missingp (send current-data :active-data-matrix '(numeric))))
      (send self :visualize-data :multivariate t))
     (t
;;this checks there is at least a missing value in the active-data-matrix selected.
;;If there is not then the standard visualization is produced

      ;(setf *spreadplot-container* ct)
      (let* (
             (nvar_sctmatrix 5)
             (variables (send current-data :active-variables '(numeric)))
             (obs (send current-data :active-labels))
             (data (send current-data :active-data-matrix '(numeric)))
             (normdata (normalize data))
             (infopatterns (cases-in-missing-patterns2 data))
             (label-barchar (third infopatterns))
             (label-missing-variables-in-pattern 
              (mapcar #'(lambda (i) 
                          (if   (missing-in-missing-pattern (third infopatterns) i)
                                (select variables (missing-in-missing-pattern (third infopatterns) i))
                                (list "Complete data")))
                      (iseq (length (third infopatterns)))))
             (label-missing-variables-in-pattern 
              (reverse (select label-missing-variables-in-pattern
                      (order (second infopatterns)))))
             (matrix-miss (fourth infopatterns))
             (cases-by-pattern (reverse (select (second infopatterns) (order (second infopatterns)))))
             (patterns (reverse (select (third infopatterns) (order (second infopatterns)))))
             (cases-in-patterns (reverse (select (first infopatterns) (order (second infopatterns)))))
             (missing-variables-in-pattern 
              (mapcar #'(lambda (i) 
                          (if   (missing-in-missing-pattern patterns i)
                                (select variables (missing-in-missing-pattern patterns i))
                                (list "Complete data")))
                      (iseq (length patterns))))
             
             (ct (make-container :free t :type 2 :local-menus t :show nil))
             (patterns-list (name-list 
                             (mapcar #'(lambda (x)                                      
                                         (princ-to-string 
                                          (coerce x 'list)))
                                    label-missing-variables-in-pattern) 
                             
                            ; :title "Patterns"
                             :show nil))
             (a (enable-container ct))
       #|  (patterns-list 
          (send modal-dialog-proto :new
                (list
                 (send list-item-proto :new
                       (mapcar #'(lambda (x) 
                                   (princ-to-string 
                                    (coerce x 'list)))
                               missing-variables-in-pattern)
                       :action #'(lambda () 
                                   (send patterns-list 
                                         :build-patterns (send self :selection)))))))|#
             (non-missing-data-rows (set-difference 
                                     (iseq (array-dimension data 0))
                                     (remove-duplicates 
                                      (remove 'nil (combine (list-missing data))))))
                             
             (sct-matrix (cond
                           ((equal non-missing-data-rows nil)
                            nil)
                           ((= (length (column-list data)) 1)
                            (histogram (first (column-list data))))
                           (t
                            (if (< (length (column-list data)) nvar_sctmatrix)
                                (scatterplot-matrix 
                                 (column-list data) 
                                 :variable-labels variables 
                                 :show nil)
                                (scatterplot-matrix  
                                 (select (column-list data) 
                                         (iseq nvar_sctmatrix))
                                 :variable-labels 
                                 (select variables 
                                         (iseq nvar_sctmatrix)) :show nil)))))
         
             (boxplot-patterns 
              (boxplot (list (list 1 2 3) (list 1 2 3))
                       :enable-equate t :equate t :diamonds t :boxes nil :show nil))
         
             (obs-list (name-list obs :show nil) )
             (hist (histogram  (first (column-list data)) 
                           :variable-labels variables :show nil ))
             (barcha (bar-graph2 
                      (mapcar #'(lambda (row) 
                                  (princ-to-string (coerce row 'list)))
                              (row-list matrix-miss))
                      :variable-labels "Count of patterns"
                      :auto-sort t
                      :show nil))
             ;(a (break))
             #|(barcha (bar-graph2 (list cases-by-pattern)
                               :category-labels missing-variables-in-pattern
                               :freqs t
                               :variable-labels "Count of patterns" :show nil))|#
             (dataobject current-data)
             (sp nil)
             )
        
        (send barcha :cat-labels (mapcar #'(lambda (x) 
                                             (princ-to-string 
                                              x))
                                         (reverse label-missing-variables-in-pattern)))
        (mapcar #'(lambda (plot)
                   	(send plot :use-color t)
                    (send plot :point-color (iseq (send obs-list :num-points)) 'blue)
                
                    )
                (list obs-list hist))


                (send patterns-list :has-h-scroll t)
(send hist 
          :plot-buttons 
          :margin (list 0 17 0 0) 
          :new-x t 
          :new-y nil
      :bottom-tool-bar t
      :curves t 
      
          :mouse-mode t)
    (send hist :use-color t)
    

    (defmeth boxplot-patterns :prepare-data (args)
      (let* ((rows-selected (if (> (length (combine args)) 1)
                                (combine
                                 (mapcar #'(lambda (var) 
                                             (select cases-in-patterns var)) 
                                         (combine args)))
                                (combine (select cases-in-patterns args))))
             (cols-selected (if (> (length (combine args)) 1)
                                (my-intersection 
                                 (mapcar #'(lambda (var) 
                                             (observed-in-missing-pattern patterns var))
                                         (combine args)))
                                (observed-in-missing-pattern patterns 
                                                             (first (combine args)))))
             (new-data (column-list (select data rows-selected cols-selected)))
             (rows-non-selected (mapcar #'(lambda (col) 
                                            (set-difference 
                                             (id-non-missing col) 
                                             rows-selected)) 
                                        (select (column-list data) cols-selected)))
             (data-observed-not-in-pattern (mapcar #'(lambda (r c) 
                                                   (select data r c)) 
                                               rows-non-selected cols-selected))
             (descriptives-not-in-pattern (mapcar #'(lambda (d) 
                                                   (list (mean d) (standard-deviation d))) 
                                               data-observed-not-in-pattern))
             (new-data (mapcar #'(lambda (col m-s) (/ (- col 
                                                              (first m-s))
                                                              (second m-s)))
                               new-data descriptives-not-in-pattern))
             (with-var (mapcar #'(lambda (x) (not (= x 0))) 
                           (mapcar #'(lambda (y) (sum (**  (- y (mean y)) 2))) new-data)))
             (non-zero-variables (if with-var (which with-var) nil)) ;encuentra variables con varianza cero
             )
        (list new-data non-zero-variables with-var)))

(defmeth boxplot-patterns :draw-plot (prepare-data pattern)
  (let (
        (new-data (first prepare-data))
        (non-zero-variables (second prepare-data))
        (with-var (third prepare-data))
        (args pattern))
    (send self :start-buffering)
    (when (not new-data) 
          (send self :equate nil)
          (send self :enable-equate nil)
          (send self :clear))
                    
    (when (or (= (length new-data) 1) (position 'nil with-var)) ;checks there is data with only an observation or any variable does not have variance
          
          (send self :clear)
          (send self :equate nil)
          (send self :enable-equate nil)
          (send self :new-plot new-data)
          (send self :variable-labels 
                (select variables 	
                        (if (> (length (combine args)) 1)
                            (my-intersection
                             (mapcar 
                              #'(lambda (var) (observed-in-missing-pattern patterns var)) 
                              (combine args)))
                            (observed-in-missing-pattern patterns 
                                                         (first (combine args))))))
          )
    
                       
    (when (and (> (length (first new-data)) 1) (not (position 'nil with-var))) ;checks there are data with more than an observation and all of them have variance
          (send self :enable-equate t)
          (send self :equate nil)
          (send self 
                :new-plot new-data)
   
          
          (send self :variable-labels 
                (select variables 	
                        (if (> (length (combine args)) 1)
                            (my-intersection 
                             (mapcar 
                              #'(lambda (var) (observed-in-missing-pattern patterns var)) 
                              (combine args)))
                            (observed-in-missing-pattern patterns 
                                                         (first (combine args))))))
          )
    
    (when (> (length (combine args)) 1)
          
          (send self :point-label
                (iseq (length 
                       (combine 
                        (mapcar #'(lambda (var) (select cases-in-patterns var))
                                (combine args)))))
                (select obs (combine (mapcar #'(lambda (var) (select cases-in-patterns var))
                                             (combine args))))))
    (when (= (length (combine args)) 1)
          (send self :point-label          
                (iseq (length 
                       (select cases-in-patterns 
                               (first (combine args)))))
                (select obs (select cases-in-patterns (first (combine args))))))         
    (send self :range '1 -3.5 3.5)
    (send self :abline 0 0 :color 'orange :type 'dashed)
    (send self :redraw)
    (send self :buffer-to-screen)
  ))


   (send boxplot-patterns  :draw-plot (send boxplot-patterns :prepare-data 0) 0)

  ; (when (= (length (first bxplot-data)) 1) (send boxplot-patterns :enable-equate nil) (send boxplot-patterns :equate nil))
  ;(when (> (length (first bxplot-data)) 1) (send boxplot-patterns :point-label (iseq (length (first (last cases-in-patterns)))) ;(select obs (first (last cases-in-patterns)))))
 ; (send boxplot-patterns :variable-labels (select variables (observed-in-missing-pattern patterns (1- (length patterns)))))
                                                             
    
   (send boxplot-patterns :enable-connect-points t)
   
    (send boxplot-patterns :connect-points t)
    	(send boxplot-patterns :showing-labels t)
       
         


#|(defmeth hist :new-x ()
  (let* ((axis "X")
         (current-varnum 0)
         (ndim (length (column-list data)))
         (result (send self :new-variable-dialog))
                       
         )
    
    (when (> (length result) 0)
          (setf result (select result 0))
          (cond 
            ((not result) (error-message "You must select a variable"))
            (t
             (send self :clear)
             (send self :add-points (first (select (column-list data) (list result))))
             (send self :title (first (select variables (list result))))
             (send self :adjust-to-data)
                   )))))
|#

(when sct-matrix
      (send sct-matrix :point-color (iseq (send obs-list :num-points)) 'blue)
      (send sct-matrix 
             :plot-buttons 
             :margin (list 0 17 0 0) 
             :new-x t
             :new-y nil 
            :mouse-mode t)
      (send sct-matrix :use-color t)
      
    
      (defmeth sct-matrix :new-x (&optional args)
        (enable-container ct)
        (let* ((axis "X")
               (current-varnum 0)
               (ndim (length (column-list data)))
               (result (send self :new-variable-dialog))
               (variables variables)
               (size (send self :size))
               (position (send self :location))
               (ptcolor (send self :point-color (iseq (send self :num-points))))
               )
          
          (when (> (length result) 0)
                (setf result (select result 0))
                (cond 
                  ((not result) (error-message "You must select a variable"))
                  (t
                   
                   ;(send self :clear) this does not work
                   (send self :variable-labels (select variables (reverse result)))
                   (send self :allocate) ;it works a bit bad but does
                   (send self :start-buffering)
                   (send self :add-points (select (column-list data) (reverse result)))
                   (send self :margin 0 19 0 0)
                   (send self :size (first size) (second size))
                   (send self :location (first position) (second position))
                   (send self :point-color (iseq (send self :num-points)) ptcolor)
                   (send self :linked t)
                   (send self :adjust-to-data)  
                   (send self :redraw)
                   (send self :buffer-to-screen)
                   ))))
        (disable-container))

        

      (defmeth sct-matrix :spreadplot-help ()
        (plot-help-window (strcat "Spreadplot Help"))
        (paste-plot-help (format nil ""))
        (show-plot-help))
      

      (send sct-matrix
            :add-mouse-mode 'focus-on-variables
            :title "Focus On Variables"
            :click :do-new-variable-focus
            :cursor 'finger)
      (send sct-matrix :mouse-mode 'focus-on-variables)

      (defmeth sct-matrix :new-variable-dialog ()
        "Arg: AXIS &OPTIONAL CUR-VARS
Presents a dialog box to choose a variable to be used on AXIS x y or z. Returns (var-name) for choice, (nil) for OK but no choice, nil for cancel."
        (let* ((row-pix 16)
               (variables variables)
               (current-var (coerce (send self :variable-labels) 'list))
               (title (send text-item-proto :new 
                            (format nil "Select a variable of each list and then exchange variables")))
               (cancel (send modal-button-proto :new "Cancel"))
               (varlist2  (send list-item-proto :new variables)) 
               (varlist (send list-item-proto :new (repeat "" (length variables))))
               (var nil)
               (ok (send modal-button-proto :new "OK" :action  
                         #'(lambda () 
                             (setf var 
                                   (set-difference 
                                    (iseq (length variables)) 
                                    (which 
                                     (map-elements 'equal "" 
                                                   (send varlist :slot-value 'list-data))))))))
               (exchange (send modal-button-proto 
                               :new "Exchange variables"))
               
               
               (dialog nil)
               (result nil))

    
          (defmeth exchange :do-action ()
      
            (when (and (not (equal (select (send varlist :slot-value 'list-data)
                                           (send varlist :selection)) ""))
                       (not (equal (select (send varlist2 :slot-value 'list-data) 
                                           (send varlist2 :selection)) ""))
                       (send varlist :selection)
                       (send varlist2 :selection))
                  (send varlist2 :set-text 
                        (send varlist :selection) 
                        (select variables (send varlist :selection)))
                  (send varlist2 :set-text
                        (send varlist2 :selection)
                        "")
                          
                  (send varlist :set-text
                        (send varlist2 :selection)
                        (select variables (send varlist2 :selection)))
                  (send varlist :set-text
                        (send varlist :selection)
                                "")
                  (send varlist :selection nil)
                  (send varlist2 :selection nil)
                  
                  ))
          

          (defmeth sct-matrix :update-plotcell (i j &rest args)
            (when (and (= i 0) (= j 2))
                  (if args (send self :selection 
                                 (combine (select cases-in-patterns (combine args))))
                      (send self :selection nil)))
            )
          
   

       (setf dialog 
             (send modal-dialog-proto :new
                   (list title 
                         (list varlist exchange varlist2) 
                         (list ok cancel)) :default-button ok))
    (mapcar '(lambda (index) 
               (send varlist2 :set-text index  "")) 
            (mapcar '(lambda (a) (position a variables)) current-var))
    (mapcar '(lambda (index var) 
               (send varlist :set-text index  var)) 
            (mapcar '(lambda (a) (position a variables)) current-var) current-var)
    (setf result (send dialog :modal-dialog))
    
    (list var))))

    
    
    (defmeth hist :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil ""))
      (show-plot-help))

(send barcha 
          :plot-buttons 
          :margin (list 0 17 0 0) 
          :new-x nil 
          :new-y nil 
          :mouse-mode nil)
    (send barcha :use-color t)
    (defmeth barcha :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil ""))
      (show-plot-help))

        (defmeth patterns-list :do-click  (x y z w)   
          (call-next-method x y z w)        
          (send sp :update-spreadplot 0 2 
                (send self :selection ))
          )
        (defmeth boxplot-patterns :do-click  (x y z w)   
          (call-next-method x y z w)        
          (send sp :update-spreadplot 1 3 
                (send self :selection ))
          )


        (defmeth Boxplot-patterns :update-plotcell (i j &rest args)
          (when (and (= i 0) (= j 2))        
                (let (
                      (prepare-data (send self :prepare-data (combine args))))
                  (send self :draw-plot prepare-data (combine args))              
                  )))

        (defmeth hist :update-plotcell (i j &rest args)
     
          (when (and (= i 0) (= j 2))
                (if args (send self :selection 
                               (combine (select cases-in-patterns (combine args))))
                    (send self :selection nil))) ;they are here but they do not do anything interesting
          ; because plots do listwise deletion
          (when (and (= i 0) (= j 0))
                (let* (
                       (args (first args))
                       (title-var (first (first (second args))))
                       )
                  (send self :show-new-var "X" title-var) ;PV the method for show-new-var in the histogrm.lsp has to be changed 
                  ))
          ) 


        (defmeth hist :show-new-var (axis variable)
          (let* ((slider (send self :slot-value 'slider))
                 (color-points (send self :point-color (iseq (send self :num-points))))
                 (selection (send self :selection))
                 (symbol (send self :point-symbol (iseq (send self :num-points))))
                 (point-state (send self :point-state (iseq (send self :num-points))))
                 (var-num (position variable (send self :variable-labels) :test #'equal)));PV I reproduce the original show-new-var method but with the :test part because of a bug
            (send self :clear-lines :draw nil)
            (send self :clear :draw nil)
            (send self :add-points (select (column-list data) var-num ) :draw nil)
            (send self :variable-label 0 (select variables var-num))
            (send self :adjust-to-data)
            (send self :point-color (iseq (send self :num-points)) color-points)
            (send self :selection selection)
            (send self :point-symbol (iseq (send self :num-points)) symbol)
            (send self :point-state (iseq (send self :num-points)) point-state)
            (when slider (send slider :value (- (send self :num-bins) 2)))
            (when (send self :show-normal) (send self :add-normal))
            (when (send self :show-kernel) 
                  (send self :add-kernel (send self :kernel-type)))))


    (defmeth obs-list :update-plotcell (i j &rest args)
      (when (and (= i 0) (= j 2))
            (if args (send self :selection 
                           (combine (select cases-in-patterns (combine args))))
                (send self :selection nil)))   
      )

    ; (defmeth barcha :update-plotcell (i j &rest args)
     
      ;      (when (and (= i 0) (= j 2))
       ;          (send self :selection  (combine args))
     ;)) the histofreq works in a strange way so I have unlinked it

   (defmeth patterns-list :compute-size ()
      (send self :size
            (round (* 1.1 (max (mapcar '(lambda (pat) (send self :text-width pat)) 
              (mapcar #'(lambda (x)                                      
                          (princ-to-string 
                           (coerce x 'list)))
                      missing-variables-in-pattern)))))
           100))
            
      
      ;(send patterns-list :location 0 25)
        

    (setf sp  (if sct-matrix
                  (spread-plot (matrix (list 2 3) 
                                       (list 
                                        obs-list 
                                        Boxplot-patterns 
                                        hist
                                        patterns-list
                                        barcha
                                        sct-matrix
                                        ))
                               :container ct 
                               ; :supplemental-plot patterns-list
                               :rel-widths (list .5 1.5 1)
                               :span-down (matrix (list 2 3) (list 1 1 1 1 1 1))
                               :statistical-object dataobject
                               :show t)
                  (spread-plot (matrix (list 2 3) 
                                       (list 
                                        obs-list 
                                        Boxplot-patterns 
                                        hist
                                        patterns-list
                                        barcha
                                        nil
                                        ))
                               :container ct 
                               ; :supplemental-plot patterns-list
                               :span-right (matrix (list 2 3) (list 1 1 1 1 2 0))
                               :span-down (matrix (list 2 3) (list 1 1 1 1 1 1))
                               :statistical-object dataobject
                               :show t)))
                                    
        
    (send sp :make-spreadplot-container-resize ct)
    (send ct :frame-location 0 0)

    (apply #'send ct :size (send ct :fix-splot-size (send ct :size)))
    ;these three sentences only work here not before building the spreadplot
    (disable-container)
 
        (send patterns-list :compute-size)
        (send (send patterns-list :container) :front-window)
        (send patterns-list :location 4 (+ 200 (second (send ct :frame-size))))
      (send ct :add-subordinate (send patterns-list :container))
        (defmeth ct :show-window ()
          (call-next-method)
          (send  (send patterns-list :container) :front-window))
        ;(send ct :show-window)
        (defmeth  (send patterns-list :container) :close ()
          (call-next-method)
          (send ct :close))
       (defmeth sp :refresh-spreadplot ()
          (call-next-method)
          (send (send patterns-list :container) :front-window))
    (send hist :linked t)
    (when sct-matrix (send sct-matrix :linked t))
    (send obs-list :linked t) 

    ;(send sp :initialize-simultaneous-move)
    ;(send (send hist :spreadplot-object) :refresh-empirical-linked-plot hist)
   ; (send (send obs-list :spreadplot-object) :refresh-empirical-linked-plot obs-list)
    ;(send (send sct-matrix :spreadplot-object) :refresh-empirical-linked-plot sct-matrix)
    
        
(defmeth sp :spreadplot-help ()
      (plot-help-window (strcat "Spreadplot Help"))
      (paste-plot-help (format nil ""))
      (show-plot-help))


))
))

  





